| Filename | (eval 1139)[/usr/share/perl5/CGI.pm:932] |
| Statements | Executed 68 statements in 328µs |
| Eval Invoked At | /usr/share/perl5/CGI.pm line 932 |
| Sibling evals | 1, 2, 3, 4, 5, 6 |
| Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
|---|---|---|---|---|---|
| 4 | 2 | 2 | 691µs | 2.18ms | CGI::header |
| Line | State ments |
Time on line |
Calls | Time in subs |
Code |
|---|---|---|---|---|---|
| 1 | # spent 2.18ms (691µs+1.49) within CGI::header which was called 4 times, avg 545µs/call:
# 3 times (608µs+1.39ms) by C4::Output::output_with_http_headers at line 285 of C4/Output.pm, avg 666µs/call
# once (84µs+98µs) by CGI::Compile::ROOT::home_vagrant_kohaclone_circ_ysearch_2epl::__ANON__[/home/vagrant/kohaclone/circ/ysearch.pl:115] at line 40 of circ/ysearch.pl | ||||
| 2 | 1 | 11µs | 5 | 28µs | my($self,@p) = self_or_default(@_); # spent 28µs making 5 calls to CGI::self_or_default, avg 6µs/call |
| 3 | 1 | 200ns | my(@header); | ||
| 4 | |||||
| 5 | 1 | 3µs | return "" if $self->{'.header_printed'}++ and $HEADERS_ONCE; | ||
| 6 | |||||
| 7 | 1 | 98µs | 5 | 404µs | my($type,$status,$cookie,$target,$expires,$nph,$charset,$attachment,$p3p,@other) = # spent 404µs making 5 calls to CGI::Util::rearrange, avg 81µs/call |
| 8 | rearrange([['TYPE','CONTENT_TYPE','CONTENT-TYPE'], | ||||
| 9 | 'STATUS',['COOKIE','COOKIES','SET-COOKIE'],'TARGET', | ||||
| 10 | 'EXPIRES','NPH','CHARSET', | ||||
| 11 | 'ATTACHMENT','P3P'],@p); | ||||
| 12 | |||||
| 13 | # Since $cookie and $p3p may be array references, | ||||
| 14 | # we must stringify them before CR escaping is done. | ||||
| 15 | 1 | 200ns | my @cookie; | ||
| 16 | 1 | 1µs | for (ref($cookie) eq 'ARRAY' ? @{$cookie} : $cookie) { | ||
| 17 | 1 | 6µs | 9 | 159µs | my $cs = UNIVERSAL::isa($_,'CGI::Cookie') ? $_->as_string : $_; # spent 152µs making 4 calls to CGI::Cookie::as_string, avg 38µs/call
# spent 7µs making 5 calls to UNIVERSAL::isa, avg 1µs/call |
| 18 | 1 | 2µs | push(@cookie,$cs) if defined $cs and $cs ne ''; | ||
| 19 | } | ||||
| 20 | 1 | 400ns | $p3p = join ' ',@$p3p if ref($p3p) eq 'ARRAY'; | ||
| 21 | |||||
| 22 | # CR escaping for values, per RFC 822 | ||||
| 23 | 1 | 3µs | for my $header ($type,$status,@cookie,$target,$expires,$nph,$charset,$attachment,$p3p,@other) { | ||
| 24 | 13 | 4µs | if (defined $header) { | ||
| 25 | # From RFC 822: | ||||
| 26 | # Unfolding is accomplished by regarding CRLF immediately | ||||
| 27 | # followed by a LWSP-char as equivalent to the LWSP-char. | ||||
| 28 | 8 | 26µs | 68 | 46µs | $header =~ s/$CRLF(\s)/$1/g; # spent 35µs making 34 calls to CGI::CORE:regcomp, avg 1µs/call
# spent 11µs making 34 calls to CGI::CORE:subst, avg 321ns/call |
| 29 | |||||
| 30 | # All other uses of newlines are invalid input. | ||||
| 31 | 8 | 28µs | 68 | 59µs | if ($header =~ m/$CRLF|\015|\012/) { # spent 32µs making 34 calls to CGI::CORE:regcomp, avg 938ns/call
# spent 27µs making 34 calls to CGI::CORE:match, avg 794ns/call |
| 32 | # shorten very long values in the diagnostic | ||||
| 33 | $header = substr($header,0,72).'...' if (length $header > 72); | ||||
| 34 | die "Invalid header value contains a newline not followed by whitespace: $header"; | ||||
| 35 | } | ||||
| 36 | } | ||||
| 37 | } | ||||
| 38 | |||||
| 39 | 1 | 500ns | $nph ||= $NPH; | ||
| 40 | |||||
| 41 | 1 | 200ns | $type ||= 'text/html' unless defined($type); | ||
| 42 | |||||
| 43 | # sets if $charset is given, gets if not | ||||
| 44 | 1 | 10µs | 5 | 30µs | $charset = $self->charset( $charset ); # spent 30µs making 5 calls to CGI::charset, avg 6µs/call |
| 45 | |||||
| 46 | # rearrange() was designed for the HTML portion, so we | ||||
| 47 | # need to fix it up a little. | ||||
| 48 | 1 | 1µs | for (@other) { | ||
| 49 | # Don't use \s because of perl bug 21951 | ||||
| 50 | 4 | 24µs | 16 | 64µs | next unless my($header,$value) = /([^ \r\n\t=]+)=\"?(.+?)\"?$/s; # spent 64µs making 16 calls to CGI::CORE:match, avg 4µs/call |
| 51 | 4 | 40µs | 64 | 411µs | ($_ = $header) =~ s/^(\w)(.*)/"\u$1\L$2" . ': '.$self->unescapeHTML($value)/e; # spent 236µs making 1 call to CGI::AUTOLOAD
# spent 133µs making 15 calls to CGI::unescapeHTML, avg 9µs/call
# spent 21µs making 16 calls to CGI::CORE:subst, avg 1µs/call
# spent 20µs making 32 calls to CGI::CORE:substcont, avg 625ns/call |
| 52 | } | ||||
| 53 | |||||
| 54 | 1 | 6µs | 5 | 10µs | $type .= "; charset=$charset" # spent 10µs making 5 calls to CGI::CORE:match, avg 2µs/call |
| 55 | if $type ne '' | ||||
| 56 | and $type !~ /\bcharset\b/ | ||||
| 57 | and defined $charset | ||||
| 58 | and $charset ne ''; | ||||
| 59 | |||||
| 60 | # Maybe future compatibility. Maybe not. | ||||
| 61 | 1 | 2µs | my $protocol = $ENV{SERVER_PROTOCOL} || 'HTTP/1.0'; | ||
| 62 | 1 | 300ns | push(@header,$protocol . ' ' . ($status || '200 OK')) if $nph; | ||
| 63 | 1 | 200ns | push(@header,"Server: " . &server_software()) if $nph; | ||
| 64 | |||||
| 65 | 1 | 700ns | push(@header,"Status: $status") if $status; | ||
| 66 | 1 | 100ns | push(@header,"Window-Target: $target") if $target; | ||
| 67 | 1 | 100ns | push(@header,"P3P: policyref=\"/w3c/p3p.xml\", CP=\"$p3p\"") if $p3p; | ||
| 68 | # push all the cookies -- there may be several | ||||
| 69 | 1 | 2µs | push(@header,map {"Set-Cookie: $_"} @cookie); | ||
| 70 | # if the user indicates an expiration time, then we need | ||||
| 71 | # both an Expires and a Date header (so that the browser is | ||||
| 72 | # uses OUR clock) | ||||
| 73 | 1 | 300ns | push(@header,"Expires: " . expires($expires,'http')) | ||
| 74 | if $expires; | ||||
| 75 | 1 | 41µs | 8 | 262µs | push(@header,"Date: " . expires(0,'http')) if $expires || $cookie || $nph; # spent 152µs making 4 calls to CGI::Cookie::as_string, avg 38µs/call
# spent 109µs making 4 calls to CGI::Util::expires, avg 27µs/call |
| 76 | 1 | 3µs | 5 | 648µs | push(@header,"Pragma: no-cache") if $self->cache(); # spent 562µs making 4 calls to CGI::cache, avg 141µs/call
# spent 86µs making 1 call to CGI::AUTOLOAD |
| 77 | 1 | 300ns | push(@header,"Content-Disposition: attachment; filename=\"$attachment\"") if $attachment; | ||
| 78 | 1 | 3µs | push(@header,map {ucfirst $_} @other); | ||
| 79 | 1 | 700ns | push(@header,"Content-Type: $type") if $type ne ''; | ||
| 80 | 1 | 3µs | my $header = join($CRLF,@header)."${CRLF}${CRLF}"; | ||
| 81 | 1 | 600ns | if (($MOD_PERL >= 1) && !$nph) { | ||
| 82 | $self->r->send_cgi_header($header); | ||||
| 83 | return ''; | ||||
| 84 | } | ||||
| 85 | 1 | 5µs | return $header; | ||
| 86 | } | ||||
| 87 | |||||
| 88 | ; |